home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / pstui100.zip / PTUI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-16  |  12.5 KB  |  379 lines
  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║    Text User     ║
  5.                                                       ║    Interface     ║
  6.                                                       ║    Rev.  1.00    ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. Unit PTUI;
  12.  
  13. {$F+} {$O-} {$A+} {$G+}
  14. {$V-} {$B-} {$X-} {$N+} {$E+}
  15.  
  16. {$I FINAL.PAS}
  17.  
  18. {$IFDEF FINAL}
  19.   {$I-} {$R-}
  20.   {$D-} {$L-} {$S-}
  21. {$ENDIF}
  22.  
  23. Interface
  24.  
  25. Uses CRT,Strings,PTUIMDef,PTUIMSE,PTUIVMSE,PTUIVCRT,KeyDef;
  26.  
  27. Const
  28.   MouseLeftButton  =    0;
  29.   MouseRightButton =    1;
  30.   MouseMiddleButton=    2;
  31.   MouseGranularity =    8;
  32.   SpecialNIL       =    Ptr($FFFF,$FFFF);
  33.  
  34. Type
  35.   LineStyles       = (DoubleLine,SingleLine,NoLine);
  36.   ShadowStyles     = (LightHash,MediumHash,DarkHash,Solid,NoShade);
  37.  
  38.   HideOrShow       = (Hidden,Visible);
  39.  
  40.   SlideBarInfo     = Record
  41.                        X1,Y1,X2,Y2        :Word;
  42.                        Forg               :Word;
  43.                        Back               :Word;
  44.                        MainChar           :Char;
  45.                        ButtonChar         :Char;
  46.                        UpLeftChar         :Char;
  47.                        DownRightChar      :Char;
  48.                        CurPos             :LongInt;
  49.                        MaxPos             :LongInt;
  50.                        ButtonScreenPos    :Word;
  51.                        ButtonNum          :Word;
  52.                        BarButtonNum       :Word;
  53.                        ButtonLeftUpNum    :Word;
  54.                        ButtonRightDownNum :Word;
  55.                      End;
  56.  
  57.   ButtonListPtr    = ^ButtonList;                {Buttons to click on}
  58.  
  59.   ButtonList = Record
  60.                  X1,Y1,X2,Y2:Word;               {Screen Co-ordinate}
  61.                  Special    :Boolean;            {Keyboard Keys}
  62.                  Key        :Char;               {Keyboard Character}
  63.                  Number     :Word;               {It's own Unique Number}
  64.                  Next       :ButtonListPtr;      {Next Button in Linked List}
  65.                End;
  66.  
  67.   ButtonChain     = Object
  68.                       Total          :Word;
  69.  
  70.                       Procedure Init;
  71.                       Function  Position     :Word;
  72.                       Function  Number       :Word;
  73.                       Procedure GotoPosition (Here:Word);
  74.                       Procedure GotoNumber   (ButtonNumber:Word);
  75.  
  76.                       Procedure Add          (X1, Y1, X2, Y2:Word;
  77.                                               Special:Boolean; Key:Char);
  78.  
  79.  
  80.                       Procedure Move         (X, Y:Integer;
  81.                                               ButtonNumber:Word);
  82.  
  83.                       Procedure MoveAll      (X, Y:Integer);
  84.  
  85.                       Procedure WaitForClick (Var X, Y:Word;Var MouseButtons:Byte;
  86.                                               Var Held,Doubled,Special:Boolean;
  87.                                               Var Key:Char);
  88.  
  89.                       Procedure KillAll;
  90.                       Procedure KillFrom;
  91.                       Procedure KillOne;
  92.  
  93.                       Private
  94.  
  95.                       Root           :Pointer;
  96.                       Buttons        :ButtonListPtr;
  97.  
  98.                       Function NewButtonNumber:Word;
  99.  
  100.                     End;
  101.  
  102.   MouseFunctions  = Object
  103.                       Init       :MouseProc_Init;
  104.                       Show       :MouseProc_Show;
  105.                       Hide       :MouseProc_Hide;
  106.                       SetSpeed   :MouseProc_SetSpeed;
  107.                       SetXY      :MouseProc_SetXY;
  108.                       SetBounds  :MouseProc_SetBounds;
  109.                       GetPresses :MouseProc_GetPresses;
  110.                       GetXY      :MouseProc_GetXY;
  111.                       GetStatus  :MouseProc_GetStatus;
  112.                       GetClick   :MouseProc_GetClick;
  113.  
  114.                       Function  ComputerSpeed:LongInt;
  115.                       Function  Active       :Boolean;
  116.  
  117.                     End;
  118.  
  119.   TextWindow      = Object
  120.                       VSlide         :SlideBarInfo;
  121.                       HSlide         :SlideBarInfo;
  122.  
  123.                       HdrButtonNum   :Word;           {Button Numbers}
  124.  
  125.                       Buttons        :ButtonChain;    {The window's buttons}
  126.  
  127.                       Card           :MonoOrColor;
  128.                       Status         :HideOrShow;     {Visible or Not}
  129.                       LineStyle      :LineStyles;     {Box Outline Style}
  130.                       ShadowStyle    :ShadowStyles;   {Shadow Style}
  131.                       ShadowXSize,
  132.                       ShadowYSize,
  133.                       BoxFrg,                       {Forg Colour}
  134.                       BoxBck,                       {Back Colour}
  135.                       ShdFrg,                       {Shadow Colour}
  136.                       ShdBck,
  137.                       HdrFrg,                       {Header Forg}
  138.                       HdrBck    :Byte;              {Header Back}
  139.                       Size,                         {Memory Required}
  140.                       X1,Y1,                        {Location on Screen}
  141.                       X2,Y2     :Word;
  142.                       Header    :String;            {Heading Line}
  143.                       HdrFmt    :TextFormats;       {Header Position}
  144.  
  145.                       Procedure Open(NX1,NY1,NX2,NY2:Word;Forg,Back,
  146.                                      ShadForg,ShadBack:Byte;
  147.                                      LStyle:LineStyles;SStyle:ShadowStyles);
  148.                       Procedure DisplayHeading;
  149.                       Procedure NewHeading(NewHead:String;NewMode:TextFormats;
  150.                                            Forg,Back:Byte);
  151.                       Procedure Hide;
  152.                       Procedure Show;
  153.                       Procedure NewPosition(NewX,NewY:Word);
  154.                       Procedure Drag;
  155.                       Procedure DragVertSlideButton;
  156.                       Procedure DragHorzSlideButton;
  157.                       Procedure NewSize(NX1,NY1,NX2,NY2:Word);
  158.                       Procedure NewStyle(Forg,Back,ShadForg,ShadBack:Byte;
  159.                                          LStyle:LineStyles;SStyle:ShadowStyles);
  160.  
  161.                       Procedure HeadingIcon           (Active:Boolean);
  162.  
  163.                       Procedure VertSlideIcon         (Active:Boolean);
  164.                       Procedure DrawVertSlideBar;
  165.                       Procedure VertSlideBar          (Details:SlideBarInfo);
  166.                       Procedure UpdateVertSlideBar    (CurPos:LongInt);
  167.  
  168.                       Procedure HorzSlideIcon         (Active:Boolean);
  169.                       Procedure DrawHorzSlideBar;
  170.                       Procedure HorzSlideBar          (Details:SlideBarInfo);
  171.                       Procedure UpdateHorzSlideBar    (CurPos:LongInt);
  172.  
  173.                       Procedure HeadingPos             (Var BX1,BY1,BX2,BY2:Word);
  174.                       Procedure VertSlideBarPos        (Var BX1,BY1,BX2,BY2:Word);
  175.                       Procedure VertSlideButtonPos     (Var BX1,BY1,BX2,BY2:Word);
  176.                       Procedure VertSlideButtonUpPos   (Var BX1,BY1,BX2,BY2:Word);
  177.                       Procedure VertSlideButtonDownPos (Var BX1,BY1,BX2,BY2:Word);
  178.                       Procedure HorzSlideBarPos        (Var BX1,BY1,BX2,BY2:Word);
  179.                       Procedure HorzSlideButtonPos     (Var BX1,BY1,BX2,BY2:Word);
  180.                       Procedure HorzSlideButtonLeftPos (Var BX1,BY1,BX2,BY2:Word);
  181.                       Procedure HorzSlideButtonRightPos(Var BX1,BY1,BX2,BY2:Word);
  182.  
  183.                       Procedure Lock;
  184.                       Procedure UnLock;
  185.                       Procedure Close;
  186.  
  187.                       Private
  188.  
  189.                       Save      :Pointer;           {Memory Area for background}
  190.  
  191.                       Procedure SaveBackground;
  192.                       Procedure DrawWindow;
  193.                     End;
  194.  
  195. Procedure EnableVScreen(VideoSystem:VideoCardTypes);
  196. Procedure DisableVScreen;
  197. Procedure InstallVScreenMouse;
  198. Procedure UnInstallVScreenMouse;
  199. Procedure GotoCard(WhereTo:MonoOrColor);
  200.  
  201. Procedure DrawOutline        (X1,Y1,X2,Y2:Word;LStyle:LineStyles);
  202. Procedure DrawShadow         (X1,Y1,X2,Y2:Word;SStyle:ShadowStyles);
  203. Procedure DrawShadowWindow   (X1,Y1,X2,Y2:Word;ShadForg,ShadBack:Byte;
  204.                               LStyle:LineStyles;SStyle:ShadowStyles);
  205. Procedure Barometer          (X,Y:Word;MaxLen:Byte;WithMe:Char;
  206.                               Current,EndPoint:LongInt);
  207.  
  208. Var
  209.   Mouse                 :MouseFunctions;
  210.   Error                 :Procedure(Num:Byte);
  211.   OldExitProc1          :Pointer;
  212.   OldExitProc2          :Pointer;
  213.  
  214. Implementation
  215.  
  216. Procedure DefaultError(Num:Byte);    {Halts with an Error}
  217. Begin
  218.   ClrScr;
  219.   Case Num Of
  220.     1:WriteLn('Out of memory.');
  221.   End;
  222.   Halt(Num);
  223. End;
  224.  
  225. Procedure EnableVScreen(VideoSystem:VideoCardTypes);
  226. Begin
  227.   If VideoSystem in [VGA,BWVGA,SVGA] Then
  228.     VideoCard[ColorCard].CharacterLength:=9
  229.   Else
  230.     If VideoSystem<>SVGA Then
  231.       VideoCard[ColorCard].CharacterLength:=8;
  232.   VideoCard[ColorCard].CardType:=VideoSystem;
  233.   OldExitProc2:=ExitProc;
  234.   ExitProc:=@DisableVScreen;
  235. End;
  236.  
  237. Procedure DisableVScreen;
  238. Begin
  239.   If OldExitProc2=SpecialNIL Then Exit;
  240.   ExitProc:=OldExitProc2;
  241.   OldExitProc2:=SpecialNIL;
  242.  
  243.   SetVirtualScreen(VideoCard[ColorCard].SX2 - VideoCard[ColorCard].SX1 + 1,
  244.                    VideoCard[ColorCard].SY2 - VideoCard[ColorCard].SY1 + 1);
  245.   ScreenOrigin(0,0);
  246. End;
  247.  
  248. Procedure InstallVScreenMouse;
  249.  
  250. Var
  251.   P,Q   :Pointer;
  252.  
  253. Begin
  254.   If Not Mouse.Active Then Exit;
  255.  
  256.   MouseHideCount :=254;
  257.   P              :=@PTUIVMSE.ControlVScreenMouse;
  258.   Asm
  259.     les    dx, P
  260.     mov    ax, 0Ch
  261.     mov    cx, 1
  262.     int    33h
  263.   End;
  264.   OldExitProc1:=ExitProc;
  265.   ExitProc:=@UnInstallVScreenMouse;
  266.  
  267.   Mouse.Show           :=PTUIVMSE.Show;
  268.   Mouse.Hide           :=PTUIVMSE.Hide;
  269.   Mouse.SetXY          :=PTUIVMSE.SetXY;
  270.   Mouse.SetBounds      :=PTUIVMSE.SetBounds;
  271.   Mouse.SetBounds(0,0,(VideoCard[Card].XSize - 1) * MouseGranularity,(VideoCard[Card].YSize - 1) * MouseGranularity);
  272.   Mouse.SetXY(0,0);
  273. End;
  274.  
  275. Procedure UnInstallVScreenMouse;
  276. Begin
  277.   If (Not Mouse.Active) Or (OldExitProc1=SpecialNIL) Then Exit;
  278.   ExitProc:=OldExitProc1;
  279.   OldExitProc1:=SpecialNIL;
  280.  
  281.   Asm
  282.     mov    ax, 0Ch
  283.     mov    cx, 0
  284.     int    33h
  285.   End;
  286.   Mouse.Show           :=PTUIMSE.Show;
  287.   Mouse.Hide           :=PTUIMSE.Hide;
  288.   Mouse.SetXY          :=PTUIMSE.SetXY;
  289.   Mouse.SetBounds      :=PTUIMSE.SetBounds;
  290. End;
  291.  
  292. Procedure GotoCard(WhereTo:MonoOrColor);
  293.  
  294. Const
  295.   MouseSaves :Array[MonoOrColor] Of Pointer = (NIL,NIL);
  296.  
  297. Var
  298.   Size       :Word;
  299.   P          :Pointer;
  300.  
  301. Begin
  302.   If Card=WhereTo Then Exit;
  303.   If Mouse.Active Then
  304.   Begin
  305.     Mouse.Hide;
  306.  
  307.     If MouseSaves[Card]=NIL Then                {Never Switched Before}
  308.     Begin
  309.       Asm
  310.         mov     ax, 15h
  311.         int     33h
  312.         mov     Size, bx
  313.       End;
  314.       System.GetMem(MouseSaves[Card],Size);
  315.     End;
  316.  
  317.     P:=MouseSaves[Card];                        {Save Driver For Current Card}
  318.     Asm
  319.       les       dx, P
  320.       mov       ax, 16h
  321.       int       33h
  322.     End;
  323.  
  324.     If MouseSaves[WhereTo]<>NIL Then            {Restore Driver For New Card}
  325.     Begin
  326.       P:=MouseSaves[WhereTo];
  327.       Asm
  328.         les       dx, P
  329.         mov       ax, 17h
  330.         int       33h
  331.       End;
  332.     End;
  333.   End;
  334.  
  335.   Card:=WhereTo;
  336.  
  337.   If Mouse.Active Then
  338.   Begin
  339.     Mouse.SetBounds(0,0,(VideoCard[WhereTo].XSize - 1) * MouseGranularity,(VideoCard[WhereTo].YSize - 1) * MouseGranularity);
  340.     Mouse.Show;
  341.   End;
  342. End;
  343.  
  344. Function MouseFunctions.ComputerSpeed:LongInt;
  345. Begin
  346.   ComputerSpeed:=PTUIMDef.ComputerSpeed;
  347. End;
  348.  
  349. Function MouseFunctions.Active:Boolean;
  350. Begin
  351.   Active:=PTUIMDef.Active;
  352. End;
  353.  
  354. {$I PTUIWIN.PAS}
  355. {$I PTUIAPP.PAS}
  356. {$I PTUIBUT.PAS}
  357.  
  358. Begin
  359.   Error                :=DefaultError;
  360.  
  361.   OldExitProc1         :=SpecialNIL;
  362.   OldExitProc2         :=SpecialNIL;
  363.  
  364.   Mouse.Init           :=PTUIMSE.Init;
  365.   Mouse.Show           :=PTUIMSE.Show;
  366.   Mouse.Hide           :=PTUIMSE.Hide;
  367.   Mouse.SetSpeed       :=PTUIMSE.SetSpeed;
  368.   Mouse.SetXY          :=PTUIMSE.SetXY;
  369.   Mouse.SetBounds      :=PTUIMSE.SetBounds;
  370.   Mouse.GetPresses     :=PTUIMSE.GetPresses;
  371.   Mouse.GetXY          :=PTUIMSE.GetXY;
  372.   Mouse.GetStatus      :=PTUIMSE.GetStatus;
  373.   Mouse.GetClick       :=PTUIMSE.GetClick;
  374.  
  375.   Mouse.Init(False);
  376. End.
  377.  
  378. { Copyright 1993, Michael Gallias }
  379.